home *** CD-ROM | disk | FTP | other *** search
- unit DLLMsgTestForm;
-
- interface
-
- uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- StdCtrls;
-
- type
- TForm1 = class(TForm)
- edtNumber: TEdit;
- btnCallDLL: TButton;
- procedure btnCallDLLClick(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
-
- var
- Form1: TForm1;
-
- implementation
-
- {$R *.DFM}
- function DLLErrorMessage(DLL: HModule; ErrorCode: DWord): string;
- var
- Len: Integer;
- Buffer: array[0..255] of Char;
- begin
- Len := FormatMessage(FORMAT_MESSAGE_FROM_HMODULE or
- FORMAT_MESSAGE_ARGUMENT_ARRAY, Pointer(DLL), ErrorCode, 0, Buffer,
- SizeOf(Buffer), nil);
- while (Len > 0) and (Buffer[Len - 1] in [#0..#32, '.']) do Dec(Len);
- SetString(Result, Buffer, Len);
- end;
-
- procedure RaiseLastWin32DLLError(DLL: HModule);
- var
- LastError: DWord;
- Error: EWin32Error;
- begin
- LastError := GetLastError;
- Error := EWin32Error.Create(DLLErrorMessage(DLL, LastError));
- Error.ErrorCode := LastError;
- raise Error;
- end;
-
- function Win32DLLCheck(DLL: HModule; RetVal: BOOL): BOOL;
- begin
- if not RetVal then
- RaiseLastWin32DLLError(DLL);
- Result := RetVal;
- end;
-
- function DoSomething(Value: Integer): Bool; stdcall;
- external 'TheDLL.DLL';
-
- procedure TForm1.btnCallDLLClick(Sender: TObject);
- begin
- Win32DLLCheck(GetModuleHandle('TheDLL.Dll'), DoSomething(StrToInt(edtNumber.Text)))
- end;
-
- end.
-